Ham Radio 2000 #1/Ham Radio 2000.iso/ham2000/packet/p_aa4re/bb212src/bbsetupg.pas

Pascal/Delphi Source File | 1992-03-12 | 13.8 KB | 422 lines

(*===========================================================================*)
(* Get parm setup routine                                                    *)
(*                                                                           *)
(*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
(*   reserved.                                                               *)
(*                                                                           *)
(*===========================================================================*)

(*===========================================================================*)
(* Get the parm                                                              *)
(*===========================================================================*)

PROCEDURE get_the_parm(p : parm_array_ptr);

  VAR
    e_str      : STRING;
    log_ext    : EXTSTR;
    log_file   : NAMESTR;
    log_path   : DIRSTR;
    i          : BYTE;
    j          : BYTE;
    parm_index : BYTE;
    t_str      : STRING;
    t_scb      : str_chain_ptr;

  VAR
    p_things : RECORD
                 CASE BYTE OF
                   0: (p_byte     : ^BYTE);
                   1: (p_char     : ^CHAR);
                   2: (p_integer  : ^INTEGER);
                   3: (p_str      : ^STRING);
                   4: (p_word     : ^WORD);
                   5: (p_long_int : ^LONGINT);
                   6: (p_user_cl  : ^user_class_type);
                   7: (p_strchn   : ^str_chain_ptr);
                   8: (p_boolean  : ^BOOLEAN);
                   9: (p_access   : access_block_ptr);
               END;

  BEGIN;

    parm_index := 1;
    WHILE (parm_index <= parm_max) AND (p^[parm_index].parm_name <> p_name) DO
      INC(parm_index);

    IF parm_index > parm_max THEN
      BEGIN;
        err_line('Invalid parameter name -- ' + p_name);
        EXIT;
      END;

    IF p = @port_parm_array THEN
      BEGIN;

        IF (work_port.port_type = port_modem)
                    AND ((parm_index = port_parm_call)
                                         OR (parm_index = port_parm_bcst)) THEN
          BEGIN;
            err_line('This parameter not valid for modems');
            EXIT;
          END;

        IF (parm_index = port_parm_ring)
                                AND (work_port.port_type <> port_modem)
                                AND (work_port.port_type <> port_null_modem)
                                AND (work_port.port_type <> port_unknown) THEN
          BEGIN;
            err_line('This parameter not valid for non-modems');
            EXIT;
          END;

      END;

    p_things.p_str := p^[parm_index].parm_addr;

    WITH p^[parm_index] DO
      IF (attr_did_this IN parm_attr)
                                   AND NOT(attr_multiple_ok IN parm_attr) THEN
        err_line('This parameter is already set -- ' + p_name)
      ELSE
        parm_attr := parm_attr + [attr_did_this];

    WITH p^[parm_index], p_things DO
      CASE parm_type OF

        parm_obsolete:
                BEGIN;
                  warn_line('This parameter is obsolete and has been ignored.'
                             + '  See CONVERT.DOC.');
                END;

        parm_string , parm_string_upper, parm_string_under, parm_char_upper,
        parm_path , parm_file, parm_file_not_exist, parm_log:
               BEGIN;

                 IF (parm_type = parm_string_upper)
                                        OR (parm_type = parm_string_under)
                                        OR (parm_type = parm_char_upper)
                                        OR (parm_type = parm_log) THEN
                   BEGIN;
                     upcase_str_var(p_value);
                     IF parm_type = parm_string_under THEN
                       BEGIN;
                         i := POS('_', p_value);
                         IF i <> 0 THEN
                           p_value[i] := ' ';
                       END;
                   END;

                 IF (p_value = 'NONE') AND (parm_type <> parm_log) THEN
                   p_value := '';

                 IF LENGTH(p_value) >= parm_str_len THEN
                   BEGIN;
                     err_line('Parm is too long');
                     EXIT;
                   END;

                 IF parm_type <> parm_char_upper THEN
                   p_str^ := p_value
                 ELSE
                   p_char^ := p_value[1];

                 IF parm_type = parm_log THEN
                   BEGIN;
                     FSPLIT(p_value, log_path, log_file, log_ext);
                     IF (log_ext = '')
                           AND ((log_file = 'WEEKLY')
                                     OR (log_file = 'MONTHLY')
                                     OR (log_file = 'DAILY')
                                     OR (log_file = 'NONE')) THEN
                       BEGIN;
                         p_value   := log_path;
                         parm_type := parm_path;
                       END
                     ELSE
                       parm_type := parm_file_not_exist;
                   END;

                 IF (parm_type <> parm_path) AND
                               (parm_type <> parm_file) AND
                               (parm_type <> parm_file_not_exist) THEN
                   EXIT;

                 work_str := p_value;

                 IF parm_type = parm_path THEN
                   IF (LENGTH(work_str) > 0) AND (work_str <> 'ANY') AND
                                    (work_str[LENGTH(work_str)] <> '\') AND
                                    (work_str[LENGTH(work_str)] <> ':') THEN
                     BEGIN;
                       err_line('Invalid format for path');
                       EXIT;
                     END
                   ELSE
                     work_str := work_str + '*.*';

                 b := test_file(work_str, parm_type <> parm_file);

                 IF NOT b THEN
                   err_line('Error during check');

               END;

        parm_byte, parm_integer, parm_word, parm_long_int:
               BEGIN;

                 VAL(p_value, i_value, code);
                 IF code <> 0 THEN
                   BEGIN;
                     err_line('Parameter not numeric');
                     EXIT;
                   END;

                 IF (i_value < parm_lo) OR (i_value > parm_hi) THEN
                   BEGIN;
                     e_str := 'Number must be between ';
                     STR(parm_lo, t_str);
                     e_str := e_str + t_str + ' and ';
                     STR(parm_hi, t_str);
                     e_str := e_str + t_str;
                     err_line(e_str);
                     EXIT;
                   END;

                 CASE parm_type OF
                   parm_byte     : p_byte^     := i_value;
                   parm_integer  : p_integer^  := i_value;
                   parm_word     : p_word^     := i_value;
                   parm_long_int : p_long_int^ := i_value;
                   ELSE
                     BEGIN;
                       WRITELN('Bad parm type in number eval --',
                                                             ORD(parm_type));
                       HALT;
                     END;
                 END;

               END;

        parm_boolean:
               p_boolean^ := yn;

        parm_speed:
               WITH work_port DO
                 BEGIN;

                   VAL(p_value, i_value, code);
                   IF code <> 0 THEN
                     BEGIN;
                       err_line('Parameter not numeric');
                       EXIT;
                     END;

                   data_rate := i_value;

                   IF i_value =  300 THEN EXIT;
                   IF i_value = 1200 THEN EXIT;
                   IF i_value = 2400 THEN EXIT;
                   IF i_value = 4800 THEN EXIT;
                   IF i_value = 9600 THEN EXIT;

                   err_line('Invalid speed setting');
                   EXIT;

                 END;

        parm_port_type:
               WITH work_port DO
                 BEGIN;

                   upcase_str_var(p_value);

                   IF p_value = 'TNC-1' THEN
                     BEGIN;
                       port_type := port_dedhost1;
                       EXIT;
                     END;

                   IF p_value = 'TNC-2' THEN
                     BEGIN;
                       port_type := port_dedhost2;
                       EXIT;
                     END;

                   IF p_value = 'PK-87-DED' THEN
                     BEGIN;
                       port_type := port_dedhost87;
                       EXIT;
                     END;

                   IF p_value = 'G8BPQ-HOST' THEN
                     BEGIN;
                       port_type := port_bpqhost;
                       port_num  := '0';
                       EXIT;
                     END;

                   IF (LENGTH(p_value) = 12)
                                  AND (substr(p_value, 1, 11) = 'G8BPQ-HOST-')
                                  AND (p_value[12] >  '0')
                                  AND (p_value[12] <= '9') THEN
                     BEGIN;
                       port_type := port_bpqhost;
                       port_num  := p_value[12];
                       EXIT;
                     END;

                   IF p_value = 'PK-87-AEA' THEN
                     BEGIN;
                       port_type := port_aeapk232;
                       EXIT;
                     END;

                   IF p_value = 'PK-232' THEN
                     BEGIN;
                       port_type := port_aeapk232;
                       EXIT;
                     END;

                   IF p_value = 'PC-1XX' THEN
                     BEGIN;
                       port_type := port_pc1xx;
                       EXIT;
                     END;

                   IF p_value = 'MODEM-ATCMD' THEN
                     BEGIN;
                       port_type := port_modem;
                       EXIT;
                     END;

                   IF p_value = 'MODEM-NULL' THEN
                     BEGIN;
                       port_type := port_null_modem;
                       EXIT;
                     END;

                   IF (p_value = 'G8BPQ-NODE') OR (p_value = 'G8BPQ_NODE') THEN
                     BEGIN;
                       port_type := port_g8bpq;
                       EXIT;
                     END;

                   IF (LENGTH(p_value) = 7)
                                      AND (substr(p_value, 1, 6) = 'PC*PA-')
                                      AND (p_value[7] >= '0')
                                      AND (p_value[7] <= '7') THEN
                     BEGIN;
                       port_type := port_pcpa;
                       port_num  := p_value[7];
                       EXIT;
                     END;

                   err_line('Port type not valid');

                 END;

        parm_user_class:
               BEGIN;

                 upcase_str_var(p_value);

                 IF p_value = 'NEW_USER' THEN
                     BEGIN;
                       p_user_cl^ := user_c_nu;
                       EXIT;
                     END;

                 IF p_value = 'UNREGISTERED_USER' THEN
                     BEGIN;
                       p_user_cl^ := user_c_uu;
                       EXIT;
                     END;

                 IF p_value = 'USER' THEN
                     BEGIN;
                       p_user_cl^ := user_c_ou;
                       EXIT;
                     END;

                 IF p_value = 'EXPERT' THEN
                     BEGIN;
                       p_user_cl^ := user_c_eu;
                       EXIT;
                     END;

                 IF p_value = 'BBS' THEN
                     BEGIN;
                       p_user_cl^ := user_c_bu;
                       EXIT;
                     END;

                 IF p_value = 'REMOTE_SYSOP' THEN
                     BEGIN;
                       p_user_cl^ := user_c_rsu;
                       EXIT;
                     END;

                 IF p_value = 'LOCAL_SYSOP' THEN
                     BEGIN;
                       p_user_cl^ := user_c_lsu;
                       EXIT;
                     END;

                   err_line('User class not valid');

               END;

        parm_str_chain,
        parm_str_chain_up:
               BEGIN;

                 IF parm_type = parm_str_chain_up THEN
                   upcase_str_var(p_value);

                 NEW(t_scb);

                 WITH t_scb^ DO
                   BEGIN;
                     str_data  := p_value;
                     str_next  := p_strchn^;
                     p_strchn^ := t_scb;
                   END;

               END;

          parm_access:
            BEGIN;

              p_access^.access_flags := 0;

              FOR i_value := 1 TO LENGTH(p_value) DO
                BEGIN;

                  j := POS(p_value[i_value], access_letter_group);
                  IF j = 0 THEN
                    BEGIN;
                      err_line('Invalid character in access list -- ' +
                               p_value[i_value]);
                      EXIT;
                    END;

                  IF j > 1 THEN
                    i := $80 SHR (j-1)
                  ELSE
                    i := $80;

                  p_access^.access_flags := p_access^.access_flags OR i;

                END;

            END;

        ELSE
          err_line('Mismatched scan table -- ' + p_name);

      END;

  END;